home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / arvis1 / regmod.bas < prev    next >
BASIC Source File  |  1997-08-09  |  9KB  |  166 lines
  1. Attribute VB_Name = "RegKeys"
  2. '»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»'
  3. ' This module reads and writes registry keys.  Unlike the '
  4. ' internal registry access methods of VB, it can read and '
  5. ' write any registry keys with string values.             '
  6. '_________________________________________________________'
  7. Option Explicit
  8. '»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»'
  9. ' Registry API Declarations... '
  10. '______________________________'
  11. Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
  12. Private Declare Function RegCreateKeyEx Lib "advapi32" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, ByRef lpSecurityAttributes As SECURITY_ATTRIBUTES, ByRef phkResult As Long, ByRef lpdwDisposition As Long) As Long
  13. Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long
  14. Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long
  15. Private Declare Function RegSetValueEx Lib "advapi32" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
  16.  
  17. '---------------------------------------------------------------
  18. '- Registry Api Constants...
  19. '---------------------------------------------------------------
  20. ' Reg Data Types...
  21. Const REG_SZ = 1                         ' Unicode nul terminated string
  22. Const REG_EXPAND_SZ = 2                  ' Unicode nul terminated string
  23. Const REG_DWORD = 4                      ' 32-bit number
  24.  
  25. ' Reg Create Type Values...
  26. Const REG_OPTION_NON_VOLATILE = 0       ' Key is preserved when system is rebooted
  27.  
  28. ' Reg Key Security Options...
  29. Const READ_CONTROL = &H20000
  30. Const KEY_QUERY_VALUE = &H1
  31. Const KEY_SET_VALUE = &H2
  32. Const KEY_CREATE_SUB_KEY = &H4
  33. Const KEY_ENUMERATE_SUB_KEYS = &H8
  34. Const KEY_NOTIFY = &H10
  35. Const KEY_CREATE_LINK = &H20
  36. Const KEY_READ = KEY_QUERY_VALUE + KEY_ENUMERATE_SUB_KEYS + KEY_NOTIFY + READ_CONTROL
  37. Const KEY_WRITE = KEY_SET_VALUE + KEY_CREATE_SUB_KEY + READ_CONTROL
  38. Const KEY_EXECUTE = KEY_READ
  39. Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _
  40.                        KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _
  41.                        KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL
  42.                      
  43. ' Reg Key ROOT Types...
  44. Public Const HKEY_CLASSES_ROOT = &H80000000
  45. Public Const HKEY_CURRENT_USER = &H80000001
  46. Public Const HKEY_LOCAL_MACHINE = &H80000002
  47. Public Const HKEY_USERS = &H80000003
  48. Public Const HKEY_PERFORMANCE_DATA = &H80000004
  49.  
  50. ' Return Value...
  51. Public Const ERROR_NONE = 0
  52. Public Const ERROR_BADKEY = 2
  53. Public Const ERROR_ACCESS_DENIED = 8
  54. Public Const ERROR_SUCCESS = 0
  55.  
  56. '---------------------------------------------------------------
  57. '- Registry Security Attributes TYPE...
  58. '---------------------------------------------------------------
  59. Private Type SECURITY_ATTRIBUTES
  60.     nLength As Long
  61.     lpSecurityDescriptor As Long
  62.     bInheritHandle As Boolean
  63. End Type
  64.  
  65.  
  66. '-------------------------------------------------------------------------------------------------
  67. 'sample usage - Debug.Print UpodateKey(HKEY_CLASSES_ROOT, "keyname", "newvalue")
  68. '-------------------------------------------------------------------------------------------------
  69. Public Function UpdateKey(KeyRoot As Long, KeyName As String, SubKeyName As String, SubKeyValue As String) As Boolean
  70.     Dim rc As Long                                      ' Return Code
  71.     Dim hKey As Long                                    ' Handle To A Registry Key
  72.     Dim hDepth As Long                                  '
  73.     Dim lpAttr As SECURITY_ATTRIBUTES                   ' Registry Security Type
  74.     
  75.     lpAttr.nLength = 50                                 ' Set Security Attributes To Defaults...
  76.     lpAttr.lpSecurityDescriptor = 0                     ' ...
  77.     lpAttr.bInheritHandle = True                        ' ...
  78.  
  79.     '------------------------------------------------------------
  80.     '- Create/Open Registry Key...
  81.     '------------------------------------------------------------
  82.     rc = RegCreateKeyEx(KeyRoot, KeyName, _
  83.                         0, REG_SZ, _
  84.                         REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, lpAttr, _
  85.                         hKey, hDepth)                   ' Create/Open //KeyRoot//KeyName
  86.     
  87.     If (rc <> ERROR_SUCCESS) Then GoTo CreateKeyError   ' Handle Errors...
  88.     
  89.     '------------------------------------------------------------
  90.     '- Create/Modify Key Value...
  91.     '------------------------------------------------------------
  92.     If (SubKeyValue = "") Then SubKeyValue = " "        ' A Space Is Needed For RegSetValueEx() To Work...
  93.     
  94.     ' Create/Modify Key Value
  95.     rc = RegSetValueEx(hKey, SubKeyName, _
  96.                        0, REG_SZ, _
  97.                        SubKeyValue, LenB(StrConv(SubKeyValue, vbFromUnicode)))
  98.                        
  99.     If (rc <> ERROR_SUCCESS) Then GoTo CreateKeyError   ' Handle Error
  100.     '------------------------------------------------------------
  101.     '- Close Registry Key...
  102.     '------------------------------------------------------------
  103.     rc = RegCloseKey(hKey)                              ' Close Key
  104.     
  105.     UpdateKey = True                                    ' Return Success
  106.     Exit Function                                       ' Exit
  107. CreateKeyError:
  108.     UpdateKey = False                                   ' Set Error Return Code
  109.     rc = RegCloseKey(hKey)                              ' Attempt To Close Key
  110. End Function
  111.  
  112. '-------------------------------------------------------------------------------------------------
  113. 'sample usage - Debug.Print GetKeyValue(HKEY_CLASSES_ROOT, "COMCTL.ListviewCtrl.1\CLSID", "")
  114. '-------------------------------------------------------------------------------------------------
  115. Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String) As String
  116.     Dim i As Long                                           ' Loop Counter
  117.     Dim rc As Long                                          ' Return Code
  118.     Dim hKey As Long                                        ' Handle To An Open Registry Key
  119.     Dim hDepth As Long                                      '
  120.     Dim sKeyVal As String
  121.     Dim lKeyValType As Long                                 ' Data Type Of A Registry Key
  122.     Dim tmpVal As String                                    ' Tempory Storage For A Registry Key Value
  123.     Dim KeyValSize As Long                                  ' Size Of Registry Key Variable
  124.     
  125.     ' Open RegKey Under KeyRoot {HKEY_LOCAL_MACHINE...}
  126.     '------------------------------------------------------------
  127.     rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' Open Registry Key
  128.     
  129.     If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' Handle Error...
  130.     
  131.     tmpVal = String$(1024, 0)                             ' Allocate Variable Space
  132.     KeyValSize = 1024                                       ' Mark Variable Size
  133.     
  134.     '------------------------------------------------------------
  135.     ' Retrieve Registry Key Value...
  136.     '------------------------------------------------------------
  137.     rc = RegQueryValueEx(hKey, SubKeyRef, 0, _
  138.                          lKeyValType, tmpVal, KeyValSize)    ' Get/Create Key Value
  139.                         
  140.     If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' Handle Errors
  141.       
  142.     tmpVal = Left$(tmpVal, InStr(tmpVal, Chr(0)) - 1)
  143.  
  144.     '------------------------------------------------------------
  145.     ' Determine Key Value Type For Conversion...
  146.     '------------------------------------------------------------
  147.     Select Case lKeyValType